home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / npol.st < prev    next >
Text File  |  1993-07-24  |  3KB  |  85 lines
  1. "    NAME        npol-fix
  2.     AUTHOR        Dr Kevin Waite <kww@cs.glasgow.ac.uk>
  3.     FUNCTION Bug Fix for Point>nearestIntegerPointOnLineFrom:to:
  4.     ST-VERSIONS    2.5
  5.     PREREQUISITES     
  6.     CONFLICTS    
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE        7 May 90
  10.     SUMMARY    Bug Fix for Point>Nearest-Point-On-Line
  11. "!
  12. "
  13. Article 1648 of comp.lang.smalltalk:
  14. From: kww@cs.glasgow.ac.uk (Dr Kevin Waite)
  15. Subject: Bug Fix for Nearest-Point-On-Line
  16. Message-ID: <5131@vanuata.cs.glasgow.ac.uk>
  17. Date: 7 May 90 15:24:17 GMT
  18. Organization: Computing Sci, Glasgow Univ, Scotland
  19.  
  20. The ParcPlace Objectworks for Smalltalk 2.5 has a bug (feature?) in the
  21. Point method #nearestIntegerPointOnLineFrom:to: (and also the floating
  22. point version, but I have not checked that out).  The problem arises
  23. when the perpendicular from the receiver Point does not touch the 
  24. given line segment.  For example, the expression 
  25.  
  26.     0@0 nearestIntegerPointOnLineFrom: 10@10 to: 100@100
  27.  
  28. returns 0@0 and not 10@10 as one would expect.  The following file-in
  29. rectifies this.   I'm sorry about the indentation but I didn't want
  30. my mailer to baulk at extra-long lines.
  31.  
  32. I hope this is of use.
  33. Cheers,
  34.    Kevin
  35.  
  36. Email:   kww@uk.ac.glasgow.cs  (JANET)
  37.      kww%cs.glasgow.ac.uk@nsfnet-relay.ac.uk  (INTERNET)
  38. Address: Dept. of Computing Science,  University of Glasgow,
  39.      17 Lilybank Gardens,  Glasgow,  United Kingdom.  G12 8QQ
  40. "
  41.  
  42.  
  43. 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 7 May 1990 at 4:11:06 pm'!
  44.  
  45.  
  46.  
  47. !Point methodsFor: 'point functions'!
  48.  
  49. nearestIntegerPointOnLineFrom: point1 to: point2 
  50.     "Answer the closest integer point to the receiver on the line 
  51.     determined by (point1, point2)--much faster than the more 
  52.     accurate version if the receiver and arguments are integer points"
  53.     "120@40 nearestIntegerPointOnLineFrom: 30@120 to: 100@120"
  54.  
  55.     | dX dY newX newY dX2 dY2 intersect scale coeff |
  56.  
  57.     dX := point2 x - point1 x.
  58.     dY := point2 y - point1 y.
  59.     intersect := dX = 0
  60.         ifTrue: [dY = 0
  61.             ifTrue: [point1]
  62.             ifFalse: [newX := point1 x.
  63.                 scale := (y - point1 y) / dY.
  64.                 newY := scale > 1 ifTrue: [point2 y] ifFalse: [
  65.                  scale < 0 ifTrue: [point1 y] ifFalse: [y]].
  66.  
  67.                 ^(newX @ newY) rounded]
  68.                 ]
  69.  
  70.         ifFalse: [dY = 0
  71.             ifTrue: [x @ point1 y]
  72.             ifFalse: 
  73.                 [dX2 := dX * dX.
  74.                 dY2 := dY * dY.
  75.                 coeff := ((dX * (y - point1 y)) - 
  76.                                          ((x - point1 x) * dY)) / (dX2 + dY2).
  77.                 newX := x + (dY * coeff).
  78.                 newY := y - (dX * coeff).
  79.                 newX @ newY]].
  80.  
  81.     scale := (intersect x - point1 x) / dX.
  82.  
  83.     ^(scale > 1 ifTrue: [point2] ifFalse: [
  84.      scale < 0 ifTrue: [point1] ifFalse: [intersect]]) rounded! !
  85.